00100	C  THIS PROGRAM CREATES FUNCTIONS FOR THE MUSIC PROGRAM USING 
00200	C  'SEG' OR 'SYNTH'.  UP TO 10 FUNCTIONS CAN BE STORED IN A
00300	C  SINGLE FILE.  ONCE CREATED, THE FUNCTIONS MAY BE CHANGED
00400	C  AND PUT BACK IN THE SAME FILE OR INTO A NEW ONE.
00500	C  NO MORE THAN 50 INPUTS FOR ONE FUNCTION!
00600	C  TYPE 'C' (= CRUNCH)  FOR SPECIAL FEATURE SUBR.
00605	C  'Z' FOR "CHANGE OR FINISH?" WILL JUMP DIRECTLY TO "CRUNCH" MODE.
00610	C  WITH S(EE), <CR> WILL REPEAT SEE COMMAND WITHOUT ASKING FOR FILE.
00620	C  'SP' (FOR "SEE") WILL PLOT ONE AT A TIME.
00625	C  'SA' PLOTS ALL IN .DAT FILE ON CALCOMP
00627	C  'SX' PLOTS ALL IN XGP FORMAT. (1ST→ <CTRL C>, A DSK PTP  --
00628	C -- WHEN DONE→ <CTRL C>, F )  THEN USE "X" PROG. TYPE 6,11,1.
00630	C FOR EXPONENTIALS GET INTO 'SEG'.  TYPE 'X', DECAY FAC, N.  IF 
00640	C  N IS NON-ZERO THE FUNCTION WILL NOT! NORMALIZE (IE. NOT GO TO 0).
00650	C  AFTER A FILE HAS BEEN READ IN, 
00750	C  <CR> FOR 'TYPE FILE' WILL HOLD ON TO IT.
00900	C  LOAD WITH -- WRIFUN,FUSUB,DFUNC,CURSOR,SSS,%LTVRLIB[1,TVR]
01000		COMMON/LN/LINE
01100		COMMON/S/H,AMP,CON,PH
01200		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
01300		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
01400		COMMON FUNC(512),F2(512),K,I
01500		DIMENSION RF(4)
01700	21	FORMAT(' C=CHANGE, F=FINISH  '$)
01800	22	FORMAT(' NEW FUNC, EDIT, CRUNCH, DELETE, RENAME, SEE?   '$)
01900	23	FORMAT(' SEG OR SYNTH?   '$)
02000	24	FORMAT(' TYPE FUNCTION NAME   '$)
02100	25	FORMAT(' TYPE FILE NAME   '$)
02200	26	FORMAT(I3,') TYPE AMPL, STEP# -- OR L=LTPEN   '$)
02300	C  'X' HERE WILL MAKE EXPON. FUNC.
02400	28	FORMAT(' 0=NORM,OR H,A,P,K   '$)
02500	280	FORMAT(' NEW VERSION!  --REPORT ANY PROBLEMS TO LCS'/
02600		1' UP TO 10 FUNCTIONS MAY BE STORED IN EACH FILE'/
02700		1' TYPE "B" TO BACKUP AT ANY TIME'//)
02800	30	FORMAT(8F)
02900	31	FORMAT(1XA5,A1,5A5/)
03000	34	FORMAT(A5,'(',A5,');',A5)
03100	35	FORMAT(1XA5,'IN FILE "',A5,'.DAT"'/)
03200	37	FORMAT(8F9.3)
03300	371	FORMAT(I3,') ',4F8.2)
03400	372	FORMAT(I,21F)
03500	38	FORMAT(2(A5,A1),23A2)
03800	40	FORMAT(11(A1,A3))
03900	41	FORMAT(' ADD TO AN EXISTING FILE?   '$)
04000	42	FORMAT(' WHICH FUNC?   '$)
04300	47	FORMAT(' C=CHNG, I=INSRT, D=DEL -- + LN# & CHNGS '$)
04400	48	FORMAT(' X,N(=DECAY FAC.) FOR XPONTLS')
04700	2281	TYPE 280
04800	281	KZ=0
04900	C   USED IN RELATIVE VECTOR ROUTINE
05000		Z=0
05050		XZ=0
05100		EY=0
05200		ICUR=0
05300		XP=0
05350		KT=0
05400		FNUM=0
05500		OLD=0
05600		FNUM1=0
05700		TYPE 22
05800		ACCEPT 40,ON,P
05900	1281	IPLOT=0
05910		XDPY=-1
06000		IF(ON.EQ.'N'.OR.(ON.EQ.' '.AND.ONX.NE.'S'))GO TO 1000
06100		IF(ON.NE.' ')GO TO 100
06200		ON=ONX
06250		XDPY=0
06275	C  <CR> FOR 'SEE' WILL DISPLAY UP TO 3 FUNCS AT ONCE.
06300	C  RETURNS FOR MORE "SEE"
06400		GO TO 4281
06500	100	ONX=ON
06600		TYPE 25
06700		OLD=-1
06800		ACCEPT 38,FLNM1
06900		IF(FLNM1.EQ.' ')FLNM1=FLNM
06950		IF(FLNM1.EQ.0.OR.LOOKD(FLNM1).EQ.0)GO TO 100
07000		IF(FLNM.NE.FLNM1)GO TO 2151
07100		OLD=0
07200	4281	TYPE 40,B
07300		GO TO 1402
07400	2151	FLNM=FLNM1
07500		CALL READ1
08200	3402	JX=-1
08300		LX=0
08310		IF(P.EQ.'A'.OR.P.EQ.'X')GO TO 402
08320	C  "SA" WILL PLOT ALL FUNCS IN FILE
08400		TYPE 40,B
08500		IF(B(1,2).NE.' ')GO TO 1402
08600		FNUM1=B(2,1)
08700	C  ONLY ONE FUNC IN FILE.
08800		GO TO 402
08900	1402	TYPE 42
09000		ACCEPT 40,BU
09100		IF(BU.EQ.'B')GO TO 281
09200		REREAD 38,FNUM1
09300		IDEL=0
09400	C  LX IS MAIN COUNTER
09500		IF(OLD)GO TO 402
09600		DO 1302 JX=1,10
09700	1302	IF(FNUM1.EQ.FN(JX))GO TO 5402
09800		GO TO 3402
09900	402	CALL READER
09910	C  AT THIS POINT LX=TOTAL FUNCS+1
09920	5402	IF(P.EQ.'A'.OR.P.EQ.'X')JX=1
10000	1202	IF(ON.NE.'C'.AND.ON.NE.'S'.AND.ON.NE.'D')GO TO 3281
10100		IF(XDPY)CALL DPYX(1)
10150		CALL DPYF(JX,FUNC)
10200		IF(P.EQ.'A'.OR.P.EQ.'X'.OR.P.EQ.'P'.OR.P.EQ.0)GO TO 2202
10300		IF(ON.EQ.'S')GO TO 2281
10400		IF(ON.EQ.'C')GO TO 1201
10500		TYPE 1139
10525		ACCEPT 40,IDEL
10550		IF(IDEL.EQ.'N')GO TO 2281
10575		IDEL=JX
10600		LX=LX-1
10630	C  NOW LX=TOTAL # OF FUNCS.
10640		CALL WRIFUN
10650	1139	FORMAT(' DELETE IT? ',$)
10675	2202	CALL PLOTIT(FUNC,XA(JX),P)
10687		IF(P.EQ.'P')GO TO 2281
10700		JX=JX+1
10710		IF(B(2,JX).NE.' '.AND.JX.LE.10)GO TO 1202
10720	C  "SA" KEEPS PLOTTING UNTIL NO MORE ARE FOUND
10730		GO TO 2281
10790	3281	X=' '
10800		TYPE 31,XA(JX),X,FN(JX)
10900		JT=4
11000		IF(XA(JX).EQ.'SEG')JT=2
11100		KZ=1
11200		DO 137	K=1,50
11300		KZ=KZ+1
11400		DO 138 L=1,JT
11500	138	A(K,L)=AA(L,K,JX)
11600	137	IF(A(K,1).EQ.999.OR.A(K,2).GE.100)GO TO 4401
12700	
12800	4401	Z=-1
12900		IF(A(K,2).LE.100)GO TO 4403
13000		IF(K.GT.1)GO TO 4404
13100		CALL DPYX(1)
13200		CALL DPYF(JX,FUNC)
14000		IF(ON.EQ.'R')GO TO 3032
14100		TYPE 4405
14120		A(1,2)=520
14250		GO TO 4201
14300	4404	TYPE 4402
14400	4403	IF(JT.EQ.2)EY='EG'
14500		GO TO 1032
14800	4402	FORMAT('  IT WAS SMOOTHED.')
14900	4405	FORMAT(' CANNOT EDIT CRUNCHED FUNCS.'/)
15000	1000	TYPE 23
15100		ACCEPT 40,BU
15200		IF(BU.EQ.'B')GO TO 281
15300		REREAD 40,X,EY
15400	1032	CALL ZERO(FUNC)
15600	C  CLEARS THE FUNC.
15700		ISMOO=0
15800		IF(EY.EQ.'EG')GO TO 800
15900	151	EY=0
16000		JT=4
16100	C  FOR WRIFUN
16200	1031	CALL DPYX(1)
16300	15	KT=1
16400	104	IF(Z.EQ.-1.OR.KT.LT.KZ)GO TO 102
16500		IF(Z.EQ.1)GO TO 2032
16600	1041	KZ=0
16700		TYPE 28
16800		ACCEPT 40,BU
16900		IF(BU.EQ.'B')GO TO 509
17000		REREAD 30,(A(KT,K),K=1,4)
17100	C ACCEPT HARM,AMPL,PHASE,KONSTANT(IF K>100, MULTIPLIES WAVE *(K-100))
17200	102	H=A(KT,1)
17300		IF(H.EQ.0.OR.H.EQ.999.)GO TO 2200
17400	C   999 ENDS 'READIN' SYNTHS
17500		IF(Z.GT.0)TYPE 371,KT,(A(KT,K),K=1,4)
17600		AMP=A(KT,2)
17700		PH=A(KT,3)
17800		CON=A(KT,4)
17900		CALL SYN(FUNC)
18000		KT=KT+1
18100		IF(KZ.LE.KT)CALL DPY(FUNC,1)
18200		GO TO 104
18210	2201	IF(JT.NE.2.OR.A(KT-1,2).GT.100)GO TO 1201
18215	C  TO USE CURRENT FUNC IN CRUNCH
18230		IF(LX.GT.10)GO TO 204
18250		CALL STORE(10)
18260	C  PUTS FROM A ARRAY TO AA ARRAY
18270		XA(K)='SEG'
18275		CALL DPYX(1)
18280		CALL DPYF(K,FUNC)
18400	1201	CALL ZFUNC
18500	C  THIS WILL BE FOR SPECIAL FEATURE PACKAGE
18510		IF(KT.EQ.512)GO TO 2281
18520	C  FOR BACKUP
18540	4201	EY='EG'
18600		KT=2
18650		GO TO 900
18700	2200	CALL NORM(FUNC)
18800	C   NORMALIZES THE FUNCTION
18900		CALL DPY(FUNC,1)
19100	201	IF(BU.EQ.'C')GO TO 2032
19200		IF(ON.EQ.'R')GO TO 3032
19300	204	TYPE 21
19400		IF(EY.EQ.'EG')TYPE 271
19500	C   CHANGE IT?
19600		ACCEPT 40,BU
19700		IF(BU.EQ.'C')GO TO 210
20000		IF(BU.EQ.'F')GO TO 900
20100		IF(BU.EQ.'S')GO TO 7000
20200		IF(BU.EQ.'Z')GO TO 2201
20250	C  TO USE CURRENT FUNC IN CRUNCH
20300		IF(BU.NE.'B')GO TO 2032
20400		IF(EY.EQ.'EG')GO TO 509
20500		GO TO 5091
20600	C   NEXT IS FOR CHANGES ('C' OR <CR>)
21200	2032	TYPE 47
21300		ACCEPT 40,K
21400		REREAD 372,L,X,RF
21500		IF(X.NE.0.OR.RF(1).NE.0)GO TO 211
21600		IF(EY.EQ.'EG')GO TO 204
21700		BU=0
21800		GO TO 1041
21900	211	L=X
22000		IF(K.EQ.'I')GO TO 212
22100		IF(K.NE.'D')GO TO 205
22200	C   JUMP IF NO DELETE
22300		KT=KT-1
22400		DO 209 K=L,KT
22500		DO 209 J=1,4
22600	209	A(K,J)=A(K+1,J)
22700		GO TO 210
22800	205	X=RF(2)
22900		IF(EY.NE.'EG')GO TO 1207
23000		IF(X.GE.A(L+1,2).AND.L.LT.KT-1)GO TO 2032
23100		GO TO 208
23200	212	IF(RF(2).NE.0)GO TO 213
23300		RF(2)=RF(1)
23400		RF(1)=X
23500		L=KT
23600	213	IF(EY.NE.'EG')GO TO 214
23700		X=RF(2)
23800		DO 215 K=1,KT
23900		Y=A(K,2)
24000		IF(X.GT.Y)GO TO 215
24100	C   JUMP IF NOT PAST STEP NUM.
24200		L=K
24300		IF(X.EQ.Y)GO TO 208
24400	C   IF STEP=ANOTHER STEP, IT WORKS LIKE 'C'HANGE.
24500		GO TO 214
24600	215	CONTINUE
24700	214	KT=KT+1
24800		DO 206 K=KT,L,-1
24900		DO 206 J=1,4
25000	206	A(K,J)=A(K-1,J)
25100		GO TO 207
25200	C   TO TYPE OLD NUMBERS
25300	208	IF(X.LE.A(L-1,2).AND.L.GT.1)GO TO 2032
25400	1207	TYPE 371,L,(A(L,K),K=1,4)
25500	207	DO 202 K=1,4
25600	202	A(L,K)=RF(K)
25700	210	KZ=KT
25800		Z=1
25900		GO TO 1032
26000	271	FORMAT('+S=SMOOTH  '$)
26010	C  FOR RENAMES
26040	3032	Z=-1
26070		GO TO 901
26100	900	TYPE 41
26200	C  ADD TO EXISTING FILE
26300		ISKP=0
26400		ACCEPT 40,Z
26500	9000	IF(Z.EQ.'B')GO TO 204
26550		IF(Z.NE.'Y'.AND.Z.NE.'N')GO TO 900
26600		TYPE 25
26700		ACCEPT 38,FLNM
26800		IF(FLNM.EQ.' '.AND.FLNM1.NE.' ')FLNM=FLNM1
26900		IF(FLNM.EQ.'B'.OR.FLNM.EQ.' ')GO TO 204
26950	CC	IF(LOOKD(FLNM).AND.Z.EQ.'N')GO TO 902
26955		IF(LOOKD(FLNM))GO TO 902
26957		IF(Z.NE.'N')GO TO 900
26960	C  LOOKD CHECKS ON LOOK-UP
27000	901	JT=4
27100		IF(EY.EQ.'EG')JT=2
27200		CALL WRIFUN
27300		GO TO 900
27400	C  COMES BACK IF NO ROOM IN FILE FOR NEW FUNC.
27405	902	IF(Z.NE.'N')GO TO 901
27410		TYPE 381,FLNM
27420		ACCEPT 40,Z
27430		IF(Z.NE.'N')GO TO 901
27440		GO TO 9000
27470	381	FORMAT(' WRITE OVER ',A5,'.DAT?  ',$)
27500	
27600	161	DO 261 K=1,512
27700	261	FUNC(K)=EXP((1-K)/STEP)
27800		KT=2
27900		XP=-1
28000		IF(H.NE.0)GO TO 7009
28100	C  H≠0 = NO NORMALIZATION OF XPONTL
28200		X=FUNC(512)
28300		DO 361 K=1,512
28400	361	FUNC(K)=FUNC(K)-(K-1)/511.*X
28500		GO TO 7009
28600	800	IF(XP)GO TO 510
28700		X=0
28800		JT=2
28900	C  JT AND EY SEEM TO PERFORM THE SAME FUNCTIONS??
29000		Y=0
29100		KT=1
29200		N=-256
29300		CALL DPYX(2)
29400		CALL DPYBRT(5)
29700	504	IF(KT.GE.KZ)GO TO 510
29800		AMP=A(KT,1)
29900	5008	STEP=A(KT,2)
30000		IF(STEP.LE.A(KT-1,2).AND.KT.GT.1)GO TO 509
30100	C   SO IT CAN'T GO BACKWARDS
30200		GO TO 5071
30300	434	ICUR=0
30400		CALL CLRCUR
30500		GO TO 510
30600	C   EXIT FROM CURSOR
30700	CC431	CALL SETCUR(-256,128,0)
30750	431	NX=-256
30760		NY=128
30770		NZ=0
30800	C  TYPE <CR> HERE TO SET FIRST POINT AT 0,0
30900		ICUR=-1
30910	433	CALL SETCUR(NX,NY,NZ)
30920		NZ=1
30930	C  =1 TO DRAG ALONG VECTOR
31000		TYPE 432,KT
31100		ACCEPT 40,AB
31200		IF(AB.EQ.'B')GO TO 509
31300		IF(AB.EQ.'R')GO TO 434
31400		MX=NX
31500		MY=NY
31600		CALL RDCUR(NX,NY)
31700	CC	CALL SETCUR(NX,NY,1)
31800		STEP=(NX+256)/5.12
31900		AMP=(NY-128)/256.
32000		IF(KT.EQ.1)STEP=1.
32100		IF(STEP.LT.100)GO TO 5571
32200		AMP=((STEP-100)/(STEP-A(KT-1,2)))*(A(KT-1,1)-AMP)+AMP
32300		ICUR=0
32400		CALL CLRCUR
32500		STEP=100.
32600	5571	TYPE 37,AMP,STEP
32700		GO TO 5071
32800	611	FORMAT(' NO MORE THAN 50 SEGS'/)
32900	610	TYPE 611
33000	509	KT=KT-1
33100	CC	IF(ICUR)CALL SETCUR(MX,MY,1)
33200	5091	IF(KT.LT.1)GO TO 281
33300		GO TO 210
33400	432	FORMAT(I3,') <CR>=SEG, B=BACKUP, R=RETURN  '/)
33500	510	IF(ICUR)GO TO 433
33600		IF(KT.EQ.1)TYPE 48
33700		TYPE 26,KT
33800		KZ=0
33900		ACCEPT 40,BU
34000		IF(BU.EQ.'B')GO TO 509
34100		IF(BU.EQ.'L')GO TO 431
34200	61	REREAD 30,AMP,STEP,H
34300		IF(STEP.LT.1)STEP=1
34400		IF(BU.EQ.'X')GO TO 161
34500	C  TYPE 'X' FOR EXPON. FUNC. + DECAY FACTOR, +1 = NO NORM.
34600	C  WE START WITH STEP 1 (NOT 0)
34700	5071	IF(KT.GT.50)GO TO 610
34800	C   TOO MANY SEGS
34900		IF(Z.GT.0)TYPE 371,KT,AMP,STEP
35000		IF(STEP.GT.100)STEP=100
35200		DIF=AMP-Y
35400		IF(STEP-X.LE.0.AND.KT.NE.1)GO TO 504
35500	C   SO IT CAN'T BACKUP HERE
35700		IF(STEP.LE.1.)Y=AMP
35710	203	YSTP=STEP
35720		IF(YSTP.GT.1)GO TO 1203
35730		YSTP=0
35740		X=-1
35800	1203	JJX=X*5.120-256
35900		NX=YSTP*5.120-256
36000		NY=AMP*256.+128.
36100		IZ=Y*256.+128.
36200		CALL ALINE(JJX,IZ,NX,NY)
36300		CALL DPYOUT(1)
36400	12	Y=AMP
36500		X=YSTP
36600		A(KT,1)=Y
36700	CC	A(KT,2)=X
36750		A(KT,2)=STEP
36800	7001	KT=KT+1
36900	C   KT COUNTS SEGMENTS
37000		IF(STEP.LT.100)GO TO 504
37100		GO TO 201
37200	
37800	7000	IF(ISMOO)GO TO 201
37900		IF(KT.LE.20)GO TO 7007
38000		TYPE 7008
38100		GO TO 509
38200	7008	FORMAT(' NO MORE THAN 20 SEGS IN CURVES'/)
38300	7007	CALL SSS(A,KT-1,FUNC)
38400	C   DRAWS GRID 2
38500	7009	CALL DPY(FUNC,2)
38600		A(KT-1,2)=520
38700		ISMOO=-1
38800	C  SO YOU CAN'T COME BACK 2 TIMES
38900		GO TO 201
39000		END